home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / intl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-04  |  9.2 KB  |  314 lines
  1. /* Various functions for internationalizing XEmacs
  2.    Copyright (C) 1993, 1994, 1995 Board of Trustees, University of Illinois
  3.  
  4. This file is part of XEmacs.
  5.  
  6. XEmacs is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU General Public License as published by the
  8. Free Software Foundation; either version 2, or (at your option) any
  9. later version.
  10.  
  11. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14. for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with XEmacs; see the file COPYING.  If not, write to the Free
  18. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* Synched up with: Not in FSF. */
  21.  
  22. /* This stuff is far, far from working. */
  23.  
  24. #include <config.h>
  25. #include "lisp.h"
  26.  
  27. #include "bytecode.h"
  28. #include "device.h"
  29.  
  30. #ifdef I18N4
  31.  
  32. XIM input_method;
  33. XIMStyle input_method_style;
  34. XIC initial_input_context;
  35. unsigned long input_method_event_mask;
  36. Atom wc_atom;
  37.  
  38. /* init_input -- Set things up for i18n level 4 input.
  39. */
  40. void init_input (CONST char *res_name, CONST char *res_class, Display *display)
  41. {
  42.   XIMStyles *styles;
  43.   unsigned short i;
  44.   
  45.   input_method = 0;
  46.   input_method_style = 0;
  47.   initial_input_context = 0;
  48.   input_method_event_mask = 0;
  49.   
  50.   input_method = XOpenIM (display, NULL,
  51.               (char *) res_name, (char *) res_class);
  52.   
  53.   if (!input_method)
  54.     {
  55.       stderr_out ("WARNING: XOpenIM() failed...no input server\n");
  56.       return;
  57.     }
  58.  
  59.   /* Query input method for supported input styles and pick one.
  60.      Right now, we choose a style which supports root-window preediting. */
  61.   XGetIMValues (input_method, XNQueryInputStyle, &styles, NULL);
  62.   for (i = 0; i < styles->count_styles; i++)
  63.     {
  64.       if (styles->supported_styles[i] == (XIMPreeditNothing|XIMStatusNothing))
  65.     {
  66.       input_method_style= styles->supported_styles[i];
  67.       break;
  68.     }
  69.     }
  70.   
  71.   if (!input_method_style)
  72.     {
  73.       stderr_out ("WARNING: Could not find suitable input style.\n");
  74.       return;
  75.     }
  76.  
  77.   initial_input_context = XCreateIC (input_method,
  78.                      XNInputStyle, input_method_style,
  79.                      NULL);
  80.   if (!initial_input_context)
  81.     {
  82.       stderr_out ("WARNING: Could not create input context.\n");
  83.       return;
  84.     }
  85.   
  86.   XGetICValues (initial_input_context,
  87.         XNFilterEvents, &input_method_event_mask,
  88.         NULL);
  89.   
  90.   /* Get a new atom for wide character client messages. */
  91.   wc_atom = XInternAtom (display, "Wide Character Event", False);
  92. }
  93.  
  94.  
  95. static widechar_string composed_input_buf = EMPTY_WIDECHAR_STRING;
  96. Window main_window;  /* Convenient way to refer to main Era window. */
  97.  
  98. /* get_composed_input -- Process results of input method composition.
  99.  
  100.    This function copies the results of the input method composition to
  101.    composed_input_buf.  Then for each character, a custom event of type
  102.    wc_atom is sent with the character as its data.
  103.  
  104.    It is probably more efficient to copy the composition results to some
  105.    allocated memory and send a single event pointing to that memory.
  106.    That would cut down on the event processing as well as allow quick
  107.    insertion into the buffer of the whole string.  It might require some
  108.    care, though, to avoid fragmenting memory through the allocation and
  109.    freeing of many small chunks.  Maybe the existing system for
  110.    (single-byte) string allocation can be used, multipling the length by
  111.    sizeof (wchar_t) to get the right size.
  112. */
  113. void
  114. get_composed_input (XKeyPressedEvent *x_key_event, XIC context,
  115.             Display *display)
  116. {
  117.   KeySym keysym;
  118.   Status status;
  119.   int len;
  120.   int i;
  121.   XClientMessageEvent new_event;
  122.  
  123.  try_again:
  124.   len = XwcLookupString (context, x_key_event, composed_input_buf.data,
  125.              composed_input_buf.size, &keysym, &status);
  126.   switch (status)
  127.     {
  128.     case XBufferOverflow:
  129.       GROW_WC_STRING (&composed_input_buf, 32);
  130.       goto try_again;
  131.     case XLookupChars:
  132.       break;
  133.     default:
  134.       abort ();
  135.     }
  136.  
  137.   new_event.type = ClientMessage;
  138.   new_event.display = x_key_event->display;
  139.   new_event.window = x_key_event->window;
  140.   new_event.message_type = wc_atom;
  141.   new_event.format = 32;  /* 32-bit wide data */
  142.   new_event.data.l[2] = new_event.data.l[3] = new_event.data.l[4] = 0L;
  143.   new_event.data.l[0] = x_key_event->time;
  144.   for (i = 0; i < len; i++) {
  145.     new_event.data.l[1] = ((wchar_t *) composed_input_buf.data)[i];
  146.     XSendEvent (display, main_window, False, 0L, (XEvent *) &new_event);
  147.   }
  148. }
  149. #endif /* I18N4 */
  150.  
  151.  
  152. Lisp_Object Qdomain;
  153. Lisp_Object Qdefer_gettext;
  154.  
  155. DEFUN ("ignore-defer-gettext", Fignore_defer_gettext, Signore_defer_gettext,
  156.        1, 1, 0,
  157.   "If OBJ is of the form (defer-gettext \"string\"), return the string.\n\
  158. The purpose of the defer-gettext symbol is to identify strings which\n\
  159. are translated when they are referenced instead of when they are defined.")
  160.   (obj)
  161.      Lisp_Object obj;
  162. {
  163.   if (CONSP (obj) && SYMBOLP (Fcar (obj)) && EQ (Fcar (obj), Qdefer_gettext))
  164.     return Fcar (Fcdr (obj));
  165.   else
  166.     return obj;
  167. }
  168.  
  169. DEFUN ("gettext", Fgettext, Sgettext, 1, 1, 0,
  170.   "Look up STRING in the default message domain and return its translation.\n\
  171. This function does nothing if I18N3 was not enabled when Emacs was compiled.")
  172.   (string)
  173.      Lisp_Object string;
  174. {
  175. #ifdef I18N3
  176.   /* #### What should happen here is:
  177.  
  178.      1) If the string has no `string-translatable' property or its value
  179.         is nil, no translation takes place.  The `string-translatable' property
  180.     only gets added when a constant string is read in from a .el or .elc
  181.     file, to avoid excessive translation.  (The user can also explicitly
  182.     add this property to a string.)
  183.      2) If the string's `string-translatable' property is a string,
  184.     that string should be returned.  `format' add this property.
  185.     This allows translation to take place at the proper time but
  186.     avoids excessive translation if the string is not destined for
  187.     a translating stream.  (See print_internal().)
  188.      3) If gettext() returns the same string, then Fgettext() should return
  189.         the same object, minus the 'string-translatable' property. */
  190.  
  191.   if (STRINGP (string))
  192.     return build_string (gettext ((char *) string_data (XSTRING (string))));
  193.   else
  194.     return string;
  195. #else
  196.   return string;
  197. #endif
  198. }
  199.  
  200. #ifdef I18N3
  201.  
  202. /* #### add the function `force-gettext', perhaps in Lisp.  This
  203.    ignores the `string-translatable' property and simply calls gettext()
  204.    on the string.  Add the functions `set-string-translatable' and
  205.    `set-stream-translating'. */
  206.  
  207. #endif
  208.  
  209. DEFUN ("dgettext", Fdgettext, Sdgettext, 2, 2, 0,
  210.   "Look up STRING in the specified message domain and return its translation.\n\
  211. This function does nothing if I18N3 was not enabled when Emacs was compiled.")
  212.   (domain, string)
  213.      Lisp_Object domain, string;
  214. {
  215.   CHECK_STRING (domain, 1);
  216.   CHECK_STRING (string, 1);
  217. #ifdef I18N3
  218.   return build_string (dgettext ((char *) string_data (XSTRING (domain)),
  219.                  (char *) string_data (XSTRING (string))));
  220. #else
  221.   return string;
  222. #endif
  223. }
  224.  
  225. DEFUN ("bind-text-domain", Fbind_text_domain, Sbind_text_domain, 2, 2, 0,
  226.   "Associate a pathname with a message domain.\n\
  227. Here's how the path to message files is constructed under SunOS 5.0:\n\
  228.   {pathname}/{LANG}/LC_MESSAGES/{domain}.mo\n\
  229. This function does nothing if I18N3 was not enabled when Emacs was compiled.")
  230.   (domain, pathname)
  231.      Lisp_Object domain, pathname;
  232. {
  233.   CHECK_STRING (domain, 1);
  234.   CHECK_STRING (pathname, 1);
  235. #ifdef I18N3
  236.   return build_string (bindtextdomain ((char *) string_data (XSTRING (domain)),
  237.                        (char *) string_data (XSTRING (pathname))));
  238. #else
  239.   return Qnil;
  240. #endif
  241. }
  242.  
  243. extern int load_in_progress;
  244.  
  245. DEFUN ("domain", Fdomain, Sdomain, 1, 1, 0,
  246.  "Specify the domain used for translating messages in this source file.\n\
  247. The domain declaration may only appear at top-level, and should preceed\n\
  248. all function and variable definitions.\n\
  249. \n\
  250. The presence of this declaration in a compiled file effectively sets the\n\
  251. domain of all functions and variables which are defined in that file.\n\
  252. Bug: it has no effect on source (.el) files, only compiled (.elc) files.")
  253.      (domain_name)
  254.      Lisp_Object domain_name;
  255. {
  256.   CHECK_STRING (domain_name, 0);
  257.   if (load_in_progress)
  258.     {
  259. #ifdef I18N3
  260.       Vfile_domain = Fpurecopy (domain_name);
  261.       return Vfile_domain;
  262. #else
  263.       return (domain_name);
  264. #endif
  265.     }
  266.   else
  267.     return Qnil;
  268. }
  269.  
  270.  
  271. /************************************************************************/
  272. /*                            initialization                            */
  273. /************************************************************************/
  274.  
  275. void
  276. init_intl_very_early (void)
  277. {
  278. #if defined (I18N2) || defined (I18N3) || defined (I18N4)
  279.   setlocale (LC_ALL, "");
  280. #endif
  281.  
  282. #ifdef I18N3
  283.   textdomain ("emacs");
  284. #endif
  285. }
  286.  
  287. void
  288. syms_of_intl (void)
  289. {
  290.   defsymbol (&Qdomain, "domain");
  291.  
  292.   /* defer-gettext is defined as a symbol because when it is used in menu
  293.      specification strings, it is not evaluated as a function by
  294.      menu_item_descriptor_to_widget_value(). */
  295.   defsymbol (&Qdefer_gettext, "defer-gettext");
  296.  
  297.   defsubr (&Signore_defer_gettext);
  298.   defsubr (&Sgettext);
  299.   defsubr (&Sdgettext);
  300.   defsubr (&Sbind_text_domain);
  301.   defsubr (&Sdomain);
  302. }
  303.  
  304. void
  305. vars_of_intl (void)
  306. {
  307. #ifdef I18N2
  308.   Fprovide (intern ("i18n2"));
  309. #endif
  310. #ifdef I18N3
  311.   Fprovide (intern ("i18n3"));
  312. #endif
  313. }
  314.